home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / gensmall.zip / _SYSPICK.TEM next >
Text File  |  1993-01-04  |  21KB  |  674 lines
  1. *****************************************************************************
  2. *****************************************************************************
  3. ** These are the modifications to the template which allows the correct
  4. ** parameters to be passed to VARFUNS.TLB's function:
  5. **       build_row_display_xpr.
  6. ** The modification was necessary for long strings which must be split for
  7. ** Clipper users, which must contain the correct quotation marks.  This
  8. ** Modification uses a variable "rowdispxpr_Q" to build the row expression
  9. ** parameter which is placed in quotes and passed to PICKDRVR.PRG.
  10. ** This only affects long "rowdispxpr's" which require splitting.
  11.  
  12. ** Modification 1): Line 54
  13. ** Modification 2): Line 138
  14. ** Modification 3): Line 360
  15. ** (John McCarvel 6-13-89)
  16. ******************************************************************************
  17. ******************************************************************************
  18.  
  19. <<title Internal pick-window generator for SMALLSYS. Do not run>>
  20. <<uicode>>
  21.  
  22. if type(_insys_) = "U"
  23.   gen_error(;
  24.  "_SYSPICK.TEM is part of the SMALLSYS system. It cannot be run separately.")
  25. endif
  26.  
  27. private pickbox                     ** the box we're generating a pick for
  28. private dad
  29. private i
  30.  
  31. **
  32. ** LINKs: set up depending on defs found in pickbox slots
  33. **
  34. private picklinks                   ** all links
  35. private plink                       ** temp
  36. private helpl                       ** help link
  37. private displ                       ** display link
  38. private appendl                     ** append link
  39. private editl                       ** edit link
  40. private deletel                     ** delete link
  41. private codename                    ** temp
  42. private codetype
  43. private linkrunner                  ** used in set_next_link()
  44. private link1
  45.  
  46. **
  47. ** privates used in generating pick list code
  48. **
  49. private field1                      ** the first field in window's item row
  50. private dbf1                        ** field1's parent DBF
  51. private firstrow, lastrow           ** 1st and last rows used by picklist
  52. private firstcol, lastcol
  53. private rowdispxpr                  ** the row display expression
  54. private rowdispxpr_Q                ** the row display expression w. quotes
  55. private autoseek                    ** generate autoseek code? flag
  56. private setproc                     ** SET PROC needed? flag
  57. private usedriver                   ** use picklist driver? flag
  58.  
  59. ** get name of dad (calling module(s)/proc(s)
  60. dad = link_dadname(picklink)
  61.  
  62. ** get name,type of this module/proc
  63. codename = link_codename(picklink)
  64. codetype = link_codetype(picklink)
  65.  
  66. ** get actual pickbox object from link line
  67. pickbox = grab_box(link_objname(picklink))
  68.  
  69. ** if we're a proc, set this
  70. if codetype = "PROC"
  71.   active_procfile = file
  72. endif
  73.  
  74. **
  75. ** set up links, if any
  76. **
  77. appendl = ""
  78. editl = ""
  79. deletel = ""
  80. helpl = ""
  81. displ = ""
  82. picklinks = array('C', 32)
  83. linkrunner = array('N',2)
  84. linkrunner[1] = 1
  85. linkrunner[2] = 1
  86. picklinks[1] = set_next_link(pickbox, codename)
  87. for i = 2 to len(picklinks)
  88.   exit when empty(picklinks[i-1])
  89.   switch link_act(picklinks[i-1])
  90.     case "APPEND"
  91.       appendl = picklinks[i-1]
  92.     case "EDIT"
  93.       editl = picklinks[i-1]
  94.     case "DELETE"
  95.       deletel = picklinks[i-1]
  96.     case "HELP"
  97.       helpl = picklinks[i-1]
  98.     case "DISPLAY"
  99.       displ = picklinks[i-1]
  100.   endsw
  101.   picklinks[i] = set_next_link(pickbox, codename)
  102. next
  103.  
  104. ** force inline display link if none specified
  105. if empty(displ)
  106.   displ = digest_link(codename, "DISPLAY {pickbox.name} ~ INLINE", ;
  107.                                 "DISPLAY", "INLINE")
  108. endif
  109.  
  110. ** if we're a module but links (just set) have implied a procfile, flag it
  111. if codetype = "MODULE" .and. (.not. empty(active_procfile))
  112.   setproc = .T.                         ** flag set proc needed
  113. endif
  114.  
  115. ** until I find out how to get the length of an array in FoxBASE 2.x,
  116. ** only Clipper Summer 87 can use the generic picklist driver
  117. if Summer87()
  118.   usedriver = ask_for_yn(";
  119.     Use generic pick list driver for {codename} (slower but smaller)?")
  120. else
  121.   usedriver = .f.
  122. endif
  123.  
  124. if usedriver
  125.   add_link_to_sys("PICKDRVR ~ ~ MODULE:{gendir}PICKDRVR.PRG {codename}")
  126. endif
  127.  
  128. **
  129. ** set up pick list privates defined above
  130. **
  131. field1 = first_field_in_box(pickbox)
  132. dbf1 = field1.dbf
  133. firstrow = field1.row
  134. lastrow = last_empty_row_after(pickbox, field1.row, field1.col)
  135. firstcol = pickbox.left + iif(pickbox.outline.type,1,0)
  136. lastcol = pickbox.right - iif(pickbox.outline.type,1,0)
  137. rowdispxpr = build_row_display_xpr(pickbox, firstrow)
  138. rowdispxpr_Q = build_row_display_xpr(pickbox, firstrow, .t.)   && within quotes
  139. autoseek = use_autoseek(pickbox)
  140. **
  141. **
  142.  
  143.  
  144. ****************************************
  145. *** generate comment header          ***
  146. ****************************************
  147.  
  148. ?
  149. ? replicate('*',76)
  150. ? "**{space(72)}**"
  151.  
  152. if codetype = "PROC"
  153.   ? banrline("Procedure {link_codename(picklink)}")
  154. else
  155.   ? banrline("{link_codename(picklink)} (file {link_codefile(picklink)})")
  156. endif
  157.  
  158. if .not. empty(dad)
  159.   ? banrline("Called from {dad}")
  160. else
  161.   ? banrline("Top-level module")
  162. endif
  163.  
  164. ? "**{space(72)}**"
  165. ? banrline("Generated from box '{link_objname(picklink)}' in .WW file '{wwfile}'")
  166. ? "**{space(72)}**"
  167. ? banrline("Pick list into database {dbf1.name}.")
  168. if len(dbf1.indexes) > 0
  169.   ? banrline("Indexed on {dbf1.indexes[1].name} ('{dbf1.indexes[1].expr}')")
  170. endif
  171.  
  172. if usedriver
  173.   ? banrline("Uses generic driver PICKDRVR.PRG")
  174. endif
  175.  
  176. link1 = .f.
  177. for i = 1 to len(picklinks)
  178.   exit when empty(picklinks[i])
  179.   if .not. link1
  180.     ? "**{space(72)}**"
  181.     ? banrline("Other actions from this {codetype}:")
  182.     ? "**{space(72)}**"
  183.     link1 = .t.
  184.   endif
  185.   plink = picklinks[i]
  186.   ? banrline("   {link_act(plink)}: {link_codename(plink)} ({link_codetype(plink)})")
  187. next
  188.  
  189. ? "**{space(72)}**"
  190. for i = 1 to len(picklinks)
  191.   exit when empty(picklinks[i])
  192.   if link_codetype(picklinks[i]) = "PROC"
  193.     if active_procfile <> file
  194.       ? banrline("Procedures defined in {active_procfile}")
  195.     else
  196.       ? banrline("Procedures defined in this file.")
  197.     endif
  198.     exit
  199.   endif
  200. next
  201.  
  202. ? replicate('*',76)
  203.  
  204. if codetype = "PROC"
  205.   ?
  206.   ? "PROCEDURE {link_codename(picklink)}"
  207. endif
  208.  
  209. ?
  210.  
  211. ****************************************
  212. *** end of comment header gen,       ***
  213. *** lots of literal code starts here ***
  214. ****************************************
  215.  
  216. <<enduicode>>
  217. <<if .not. empty(dad)           ** not top system module>>
  218. PARAM retval                        && passback success var
  219. <<else>>
  220. PRIVATE retval
  221. <<endif>>
  222.  
  223. PRIVATE ok                          && passback var for append and/or delete
  224. PRIVATE t, l, b, r                  && pickbox coordinates
  225. PRIVATE locolor, hicolor            && colors
  226. <<if usedriver>>
  227. PRIVATE hotkeys                     && keys to force driver exit
  228. PRIVATE startrow                    && row offset into list, pass thru driver
  229. <<else>>
  230. PRIVATE currow, thisrow             && row save variables
  231. PRIVATE drows, dcols                && # display rows, # display columns
  232. PRIVATE rec1, recN                  && recno() save variables
  233. PRIVATE saverec, toprec             && ditto
  234. PRIVATE keyhit                         && keyhit holder
  235. PRIVATE redisp, slide               && redisplay flags
  236. PRIVATE trash                       && self-explanatory, haha
  237.  <<if autoseek>>
  238. PRIVATE seekbuf                     && autoseek buffer
  239.  <<endif>>
  240.  <<if Clipper() .or. Fox2()>>
  241. PRIVATE {pop_buf_name(pickbox)}     && screen save buffer
  242.  <<endif>>
  243. <<endif>>
  244.  
  245. <<if empty(dad)             ** top (first) module>>
  246.  <<env_setup()>>
  247. CLEAR
  248.  
  249. * global data directories
  250. dbfpath = "{dbfdir}"
  251. indexpath = "{ndxdir}"
  252.  <<init_all_dbfs("dbfpath","indexpath",.t.)>>
  253. <<endif>>
  254. SET DELETED ON                      && for picklist
  255. <<if setproc                ** do a set proc?>>
  256.  <<if Clipper()>>
  257. SET PROC TO {stripdir(striptag(active_procfile))}
  258.  <<else>>
  259. SET PROC TO {active_procfile}
  260.  <<endif>>
  261. <<endif>>
  262.  
  263. <<uicode>>
  264. ** generate commented EXTERNAL line for Clipper
  265. if Clipper()
  266.   private externstart
  267.   externstart = .F.
  268.   for i = 1 to len(picklinks)
  269.     plink = picklinks[i]
  270.     exit when empty(plink)
  271.     if (.not. empty(plink)) .and. ;
  272.        link_codetype(plink) = "MODULE"
  273.       if .not. externstart
  274.         ? "** Uncomment following line to declare modules EXTERNAL (i.e. don't compile"
  275.         ? "** into {striptag(file)}.OBJ, but specify them to the linker)"
  276.         ? "** EXTERNAL "
  277.         externstart = .T.
  278.       else
  279.         ?? ", "
  280.       endif
  281.       ?? link_codename(plink)
  282.     endif
  283.   next
  284. endif
  285. <<enduicode>>
  286.  
  287. <<if link_codetype(displ) = "INLINE">>
  288.     <<pop_box(pickbox)>>
  289. <<else>>
  290.     <<call_save_screen(pickbox, pop_buf_name(pickbox))>>
  291. DO {link_codename(displ)}
  292. <<endif>>
  293.  
  294. hicolor = "{field1.color}"
  295. locolor = "{pickbox.contents.color}"
  296. <<if .not. usedriver>>
  297.  
  298. t = {firstrow}
  299. l = {firstcol}
  300. b = {lastrow}
  301. r = {lastcol}
  302.  
  303.  
  304. saverec = recno()                   && in case this was important
  305. GO TOP                              && snag some important recno()s
  306. rec1 = recno()
  307. GO BOTTOM
  308. recN = recno()
  309. GO saverec                          && back to where we started
  310.  
  311. <<if autoseek>>
  312. seekbuf = ""                        && init seek buffer
  313. <<endif>>
  314. drows = b-t+1                       && number of displayed rows
  315. dcols = r-l+1                       && number of displayed columns
  316. currow = t                          && current row at top of pickbox
  317. redisp = -1                         && initial display, leave hilite at top
  318. slide = 0                           && no initial slide
  319.  
  320. <<do case>>
  321.   <<case Clipper()>>
  322. SET CURSOR OFF
  323.   <<case Fox2()>>
  324. ?? sys(2002)                        && cursor off
  325. <<endcase>>
  326.  
  327. <<endif>>
  328.  
  329. <<uicode>>
  330.  if usedriver
  331.    for i = 1 to len(picklinks)-1
  332.      exit when empty(picklinks[i])
  333.    next
  334.    if Clipper()
  335.      ?"DECLARE hotkeys[{i-1}]          && hot key array for driver"
  336.      for i = 1 to len(picklinks)-1
  337.        exit when empty(picklinks[i])
  338.        ?"hotkeys[{i}] = {link_key(picklinks[i])}"
  339.      next
  340.    else
  341.      ?"DIMENSION hotkeys({i-1})          && hot key array for driver"
  342.      for i = 1 to len(picklinks)-1
  343.        exit when empty(picklinks[i])
  344.        ?"STORE {link_key(picklinks[i])} TO hotkeys({i})"
  345.      next
  346.    endif
  347.  endif
  348. <<enduicode>>
  349.  
  350. SET COLOR TO &locolor, &hicolor
  351. ok = .F.                            && initialize passback var
  352. startrow = 0                        && first startrow is 0 (top of list)
  353.  
  354. DO WHILE .T.
  355. <<if usedriver>>
  356.  
  357.   keyhit = 0
  358.   DO PICKDRVR WITH ;
  359.       {firstrow}, {firstcol}, {lastrow}, {lastcol}, ;
  360.       '{rowdispxpr_Q}', ;           && enclosed in quotes
  361.       "{pickbox.contents.color}", "{field1.color}", ;
  362.       {iif(autoseek,".T.", ".F.")}, ;
  363.       hotkeys, ;
  364.       keyhit, ;
  365.       startrow
  366. <<else>>
  367.  
  368.   DO CASE                           && display stuff from flags set below
  369.  
  370. <<do case   ** hardware scroll, if flavor supports it>>
  371.   <<case Clipper()>>
  372.     CASE slide <> 0                 && slide 1 row up or down
  373.       scroll(t, l, b, r, slide)     && do hardware scroll
  374.       currow = iif(slide <0, t, b)  && set currow for hilite below
  375.       slide = 0                     && unset slide
  376.   <<case Fox2()>>
  377.     CASE slide <> 0                 && slide 1 row up or down
  378.       SCROLL t, l, b, r, slide      && do hardware scroll
  379.       currow = iif(slide <0, t, b)  && set currow for hilite below
  380.       slide = 0                     && unset slide
  381. <<endcase>>
  382.  
  383.     CASE redisp < 0                 && redisplay, leaving current rec at top
  384.       toprec = recno()              && save top rec
  385.       thisrow = t                   && display rows from t to b
  386.       DO WHILE thisrow <= b .AND. .NOT. eof()
  387.         sprint(thisrow, l, ;
  388.           {rowdispxpr} )
  389.         SKIP
  390.         thisrow = thisrow +1
  391.       ENDDO
  392.       DO WHILE thisrow <= b         && in case empty rows after eof()
  393.         sprint(thisrow, l, space(dcols) )
  394.         thisrow = thisrow +1
  395.       ENDDO
  396.       GO toprec                     && go back to top
  397.       thisrow = redisp
  398.       currow = t                    && set currow for hilite later
  399.       DO WHILE thisrow < -1
  400.         SKIP
  401.         currow = currow +1
  402.         thisrow = thisrow +1
  403.       ENDDO
  404.       redisp = 0                    && unset redisp
  405.  
  406.     CASE redisp > 0                 && redisplay, leaving current rec at bot
  407.       thisrow = t                   && display rows from t to b
  408.       DO WHILE .NOT. eof() .AND. thisrow <= b
  409.         sprint(thisrow, l, ;
  410.           {rowdispxpr} )
  411.         SKIP
  412.         thisrow = thisrow +1
  413.       ENDDO
  414.       DO WHILE thisrow <= b         && in case empty rows after eof()
  415.         sprint(thisrow, l, space(dcols) )
  416.         thisrow = thisrow +1
  417.       ENDDO
  418.       thisrow = thisrow -1
  419.       SKIP -1
  420.       DO WHILE redisp > 1
  421.         thisrow = thisrow -1           && set currow for hilite, below
  422.         redisp = redisp -1
  423.       ENDDO
  424.       currow = thisrow
  425.       redisp = 0
  426.  
  427.   ENDCASE
  428.  
  429.                                     
  430.   sprint(currow, l, ;
  431.     {rowdispxpr}, hicolor )         && hilite current item
  432.  
  433.   keyhit = inkey(0)                 && get keyhit
  434.   CLEAR TYPEAHEAD                   && need all the speed we can get
  435.  
  436. <<endif>>
  437.  
  438.   DO CASE                           && key hit action loop
  439.  
  440. <<uicode>>
  441. ** the links
  442. for i = 1 to len(picklinks)
  443.   plink = picklinks[i]
  444.   exit when empty(plink)
  445.   switch link_act(plink)
  446.     case "EDIT"             ** edit link
  447.      <<enduicode>>
  448.     CASE keyhit = {link_key(plink)}
  449.       DO {link_codename(plink)} WITH ok && edit current record
  450.       SET COLOR TO &locolor, &hicolor   && just in case
  451.      <<if .not. usedriver>>
  452.       IF ok
  453.         SKIP -(currow-t)
  454.         redisp = -1-(currow-t)          && redisp
  455.       ENDIF
  456.      <<endif>>
  457.  
  458.      <<uicode>>
  459.     case "APPEND"           ** append link
  460.      <<enduicode>>
  461.     CASE keyhit = {link_key(plink)}
  462.       DO {link_codename(plink)} WITH ok
  463.       SET COLOR TO &locolor, &hicolor   && just in case
  464.      <<if .not. usedriver>>
  465.       IF ok                             && we really appended
  466.         SKIP -(currow-t)
  467.         redisp = -1-(currow-t)          && redisp
  468.       ENDIF
  469.      <<endif>>
  470.  
  471.      <<uicode>>
  472.     case "DELETE"           ** delete link
  473.      <<enduicode>>
  474.     CASE keyhit = {link_key(plink)}
  475.      <<if link_codetype(plink) = "INLINE" ** inline, generate it here>>
  476.       <<q_indent = 6>>
  477.       <<gen_confirm(plink)>>
  478.       <<q_indent = 0>>
  479.       hicolor = "{field1.color}"
  480.       locolor = "{pickbox.contents.color}"
  481.      <<else                                 ** proc/module, just call it here>>
  482.       DO {link_codename(plink)} WITH ok   && delete current record
  483.      <<endif>>
  484.      <<if .not. usedriver>>
  485.       IF ok                         && we actually deleted it
  486.         SKIP -(currow-t)
  487.         redisp = -1-(currow-t)          && redisp
  488.       ENDIF
  489.      <<endif>>
  490.       SET COLOR TO &locolor, &hicolor   && just in case
  491.  
  492.      <<uicode>>
  493.  
  494.     case "HELP"             ** help link
  495.      <<enduicode>>
  496.     CASE keyhit = {link_key(plink)}
  497.      <<if link_codetype(plink) = "INLINE"   ** inline, generate it here>>
  498.       <<q_indent = 6>>
  499.       <<gen_disphit(plink)>>
  500.       <<q_indent = 0>>
  501.       hicolor = "{field1.color}"
  502.       locolor = "{pickbox.contents.color}"
  503.       SET COLOR TO &locolor, &hicolor   && just in case
  504.      <<else                                 ** proc/module, just call it here>>
  505.       DO {link_codename(plink)}     && pop help
  506.       SET COLOR TO &locolor, &hicolor   && just in case
  507.      <<endif>>
  508.  
  509.      <<uicode>>
  510.  
  511.     otherwise                       ** some other kinda link, menu prolly
  512.      <<enduicode>>
  513.     CASE keyhit = {link_key(plink)}
  514.       DO {link_codename(plink)} WITH ok
  515.       SET COLOR TO &locolor, &hicolor   && just in case
  516.      <<if .not. usedriver>>
  517.       IF ok                             && we really appended
  518.         SKIP -(currow-t)
  519.         redisp = -1-(currow-t)          && redisp
  520.       ENDIF
  521.      <<endif>>
  522.      <<uicode>>
  523.  
  524.   endsw
  525. next
  526. <<enduicode>>
  527.  
  528.     CASE keyhit = 13                   && car. ret. -- recno() is already set
  529.       retval = .T.
  530.       EXIT
  531.  
  532.     CASE keyhit = 27                   && escape
  533.       retval = .F.
  534.       EXIT
  535. <<if .not. usedriver>>
  536.  
  537.     CASE keyhit = 5                    && up
  538.       IF recno() = rec1             && at top?
  539.         ?? chr(7)
  540.       ELSE
  541.         && unhilite current selection
  542.         sprint(currow, l, ;
  543.           {rowdispxpr}, locolor)
  544.         SKIP -1                     && decrement selected record
  545.         IF currow > t               && not the top displayed row
  546.           currow = currow - 1       && just decrement
  547.         ELSE                        && top displayed row
  548. <<if Clipper() .or. Fox2()  ** hardware scroll if possible>>
  549.           slide = -1                && set slide flag
  550. <<else                      ** otherwise plain old redisplay>>
  551.           redisp = -1               && redisplay, 1 up from current
  552. <<endif                     ** end of hardware scroll>>
  553.         ENDIF
  554.       ENDIF
  555.  
  556.     CASE keyhit = 24                   && down
  557.       IF recno() = recN             && at bottom of file?
  558.         ?? chr(7)
  559.       ELSE
  560.         && unhilite current selection
  561.         sprint(currow, l, ;
  562.           {rowdispxpr}, locolor )
  563.         SKIP                        && increment selected record
  564.         IF currow < b               && not the last displayed row
  565.           currow = currow + 1       && just increment
  566.         ELSE                        && bottom displayed row
  567. <<if Clipper() .or. Fox2()  ** hardware scroll if possible>>
  568.           slide = 1                 && set slide flag
  569. <<else                      ** otherwise plain old redisplay>>
  570.           SKIP 2-drows
  571.           redisp = 1                && redisplay, 1 up from current
  572. <<endif                     ** end of hardware scroll>>
  573.         ENDIF
  574.       ENDIF
  575.  
  576.     CASE keyhit = 18                   && page up
  577.       SKIP t - currow - drows       && skip to top of prec page
  578.       IF bof()                      && beep if at top
  579.         ?? chr(7)
  580.       ENDIF
  581.       redisp = -1                   && redisp, leaving hilite at top
  582.  
  583.     CASE keyhit = 3                    && page down
  584.       SKIP t -currow +(2*drows) -1  && skip to there we want bot. of new page
  585.       IF eof()                      && ran out of file
  586.         ?? chr(7)
  587.         SKIP -drows                 && skip to 1 page above eof()
  588.         redisp = 1                  && redisp, leaving hilite at bottom
  589.       ELSE                          && ok
  590.         SKIP 1-drows                && skip to 1 page above eof()
  591.         redisp = -1                 && redisp, leaving hilite at top
  592.       ENDIF
  593.  
  594.     CASE keyhit = 1                    && home, easy
  595.       GO TOP
  596.       redisp = -1
  597.  
  598.     CASE keyhit = 6                    && end, pretty easy
  599.       GO BOTTOM
  600.       SKIP 1-drows
  601.       redisp = 1
  602.  
  603.  <<if autoseek>>
  604.     CASE keyhit > 32 .AND. keyhit < 127   && printable char, try seeking
  605.       saverec = recno()             && save current record pos
  606.                                     && add letter to seek buffer
  607.       seekbuf = seekbuf + upper(chr(keyhit))
  608.       SEEK seekbuf                  && give it a shot
  609.       IF eof()                      && naah, beep & retreat
  610.         ?? chr(7)
  611.         seekbuf = substr(seekbuf,1,len(seekbuf)-1)
  612.         GO saverec
  613.       ELSE
  614.         SKIP -(currow-t)
  615.         redisp = -1-(currow-t)          && redisp
  616.       ENDIF
  617.  
  618.     CASE keyhit = 8                     && backspace
  619. <<if Clipper()>>
  620.       IF empty(seekbuf)                 && seek buffer's empty
  621. <<else>>
  622.       IF len(trim(seekbuf)) = 0         && seek buffer's empty
  623. <<endif>>
  624.         ?? chr(7)
  625.         LOOP
  626.       ENDIF
  627.       seekbuf = substr(seekbuf,1,len(seekbuf)-1)
  628.       SEEK seekbuf                  && we know it's here
  629.       redisp = -1
  630.  
  631.  <<endif>>
  632. <<endif>>
  633.   ENDCASE
  634.  
  635. ENDDO
  636.  
  637. <<do case>>
  638.   <<case Clipper()>>
  639. SET CURSOR ON
  640.   <<case Fox2()>>
  641. ?? sys(2002,1)                      && cursor on
  642. <<endcase>>
  643.  
  644. <<if Clipper() .or. Fox2()>>
  645.  <<unpop_box(pickbox)>>
  646. <<endif>>
  647.  
  648. <<if .not. empty(deletel)   ** we turned delete on, turn it off>>
  649. SET DELETED OFF
  650. <<endif>>
  651. <<if empty(dad)                     ** top module, shut things off>>
  652. CLOSE DATABASES                     && shut everything down
  653. <<endif>>
  654.  
  655. <<if setproc>>
  656.  <<if active_procfile <> file>>
  657. SET PROC TO
  658.  <<endif>>
  659. <<endif>>
  660.  
  661. RETURN
  662.  
  663. <<uicode>>
  664.  
  665. **
  666. ** reset active_procfile
  667. **
  668. if setproc                  ** if we opened the proc file in here, close it
  669.   active_procfile = ""
  670. endif
  671.  
  672.  
  673. <<enduicode>>
  674.